home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / SysGen / MEASURE < prev    next >
Encoding:
Text File  |  1991-06-05  |  2.6 KB  |  95 lines
  1. \ usage:   MEASURE vlist
  2. \
  3. \ for simple measurements of 1 line of keyboard input.
  4. \
  5. \ A BENCH utility can be used to correct for a known timing component
  6. \ (such as DO-LOOP times).  To set the correction value:
  7. \
  8. \          BENCH.WITH xxx   ( where xxx is a word to measure and )
  9. \                           ( subsequently factor out. )
  10. \ followed by:
  11. \
  12. \          BENCH yyy        ( where yyy is a word containing xxx )
  13. \                           ( this prints the total, correction, and )
  14. \                           ( actual times measured. )
  15. \
  16. \ Example:
  17. \
  18. \    : DO-LOOPS    10,000 0 DO LOOP ;
  19. \    BENCH.WITH  DO-LOOPS
  20. \    : DO-PLUSSES  10,000 0 DO 23 45 + drop LOOP ;
  21. \    BENCH  DO-PLUSSES
  22. \
  23. \ Copyright 1986 Delta Research
  24.  
  25. include? $interpret jf:string-interpret
  26.  
  27. decimal
  28.  
  29. variable istime  0 , 0 ,
  30. variable wastime 0 , 0 ,
  31. variable correct-ticks
  32.  
  33. : loadtime  ( adr -- , fills buffer from dos )
  34.   >abs call dos_lib datestamp  drop   ;
  35.  
  36. : .timediff  ( hundreths secs -- )
  37.   base @ >r decimal
  38.   3600 /mod -dup
  39.   IF   dup 1 .r ."  hour"  1 >
  40.        IF   ascii s emit
  41.        THEN ." , "
  42.   THEN
  43.   60 /mod -dup
  44.   IF   dup 1 .r ."  minute"  1 >
  45.        IF   ascii s emit
  46.        THEN ." , "
  47.   THEN
  48.   1 .r   ascii . emit
  49.   dup 10 <
  50.   IF    ascii 0 emit
  51.   THEN  -dup
  52.   IF    1 .r  
  53.   THEN  r> base ! ."  seconds" space ;
  54.  
  55. : .results
  56.   >newline ." That took "   .timediff  ;
  57.  
  58. : >secs   ( #ticks -- #hundreths seconds )
  59.   50 /mod  swap 2* swap   ;
  60.  
  61. : >ticks    ( #tick0 #min0 #tick1 #min1 -- #total-ticks-passed )
  62.   swap >r   ( #t0 #m0 #m1 -- )   \ save #tick1
  63.   swap -  3000 *  ( #ticks from minutes )  ( #t0 #mticks -- )  ( #t1 -r- )
  64.   r> rot - +    ( #ticks passed )
  65. ;
  66.  
  67. : .dif  ( d1 d2 -- , print difference in double numbers as time ) 
  68.   >ticks >secs  .results       \ calc and display the difference
  69. ;
  70.  
  71. : <MEAS-INTERP>  ( -- , parse & process 1 line of input input )
  72.   wastime loadtime          \ get the current time (start of 'return')
  73.   eol word pad 128 + $move
  74.   pad 128 +  count $interpret
  75.   istime  loadtime          \ load the time we are at now (20 msec ticks)
  76.   [ wastime cell+ ] literal d@  \ put the two 'times' on the stack
  77.   [ istime  cell+ ] literal d@
  78. ;
  79.  
  80. : measure  ( -- , execute command line, measure time )
  81.   <meas-interp>  .dif
  82. ;
  83.  
  84. : BENCH.WITH  ( -- , eats name of routine to correct for )
  85.   <meas-interp>  ( -- d1 d2 )
  86.   >ticks   correct-ticks !    ;
  87.  
  88. : BENCH  ( -- , measure and correct with 'correct-ticks' for true time )
  89.   <meas-interp>  ( -- d1 d2 )
  90.   >ticks dup    >newline ." Total time   = " >secs .timediff
  91.   correct-ticks @ dup cr ." T(BENCH.WITH)= " >secs .timediff
  92.   -             cr       ." Actual time  = " >secs .timediff
  93. ;
  94.   
  95.